home *** CD-ROM | disk | FTP | other *** search
/ Leisure Game Pak / Leisure Game Pak.iso / lpgame1 / 04 / source / mynesplf.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-17  |  15KB  |  411 lines
  1. (*  .....................................................................  *)
  2. (*  :    file        :  MYNESPLF.PAS                                 :  *)
  3. (*  :      contents    :  the playfield routines for MYNES!        :  *)
  4. (*  :    last update    :  30-JUN-93                                    :  *)
  5. (*  :...................:...............................................:  *)
  6. (*
  7.     - draw_playfield, restore_playfield, generate_playfield
  8.     - draw_color_bar, refresh_bar
  9.     - real_col, real_row
  10.         - explode  ... lets the playfield explode
  11.         - some general purpose routines (max, in_rect)
  12. *)
  13.  
  14. (* calculate the maximum of two integers/words/bytes/longints *)
  15. FUNCTION    max(a, b : LONGINT) : LONGINT;
  16. BEGIN
  17.     IF  (a > b)  THEN  max := a  ELSE  max := b;
  18. END;    (*  max  *)
  19.  
  20. (*  in_rect(x,y,x1,y1,dx,dy) <=> (x,y) is in (x1,y1)-(x1+dx-1, y1+dy-1)  *)
  21. FUNCTION    in_rect(x, y, x1, y1, dx, dy : INTEGER) : BOOLEAN;
  22. BEGIN
  23.     in_rect := (x >= x1) AND (x < x1+dx) AND (y >= y1) AND (y < y1+dy);
  24. END;    (*  in_rect  *)
  25.  
  26.  
  27. (*  real_col, real_row return the real coords of a tile that is out of bounds *)
  28. FUNCTION    real_col(VAR  scene : SCENE_TYPE;
  29.                     col : COL_ROW_TYPE) : COL_ROW_TYPE;
  30. BEGIN
  31.     real_col := (scene.NumCols + col) MOD scene.NumCols;
  32. END;    (*  real_col  *)
  33.  
  34. FUNCTION    real_row(VAR  scene : SCENE_TYPE;
  35.                           row : COL_ROW_TYPE) : COL_ROW_TYPE;
  36. BEGIN
  37.     real_row := (scene.NumRows + row) MOD scene.NumRows;
  38. END;    (*  real_row  *)
  39.  
  40.  
  41. PROCEDURE    refresh_bar(b: COORDS_TYPE; act_val, max_val : LONGINT);
  42. VAR    newlen    : WORD;
  43. BEGIN
  44.         HideMouse;
  45.         (*  check range  *)
  46.         IF  (act_val < 0)  THEN
  47.             newlen := 0
  48.         ELSE IF  (act_val > max_val)  THEN
  49.         newlen := COLBAR_LEN
  50.         ELSE
  51.             (*  COLBAR_LEN * act_val would overflow if act_val wasn't LONGINT *)
  52.         newlen := (COLBAR_LEN * act_val) DIV max_val;
  53.  
  54.         SetFillStyle(SOLIDFILL, BLACK);
  55.         Bar(b.x + newlen, SUCC(b.y), b.x + COLBAR_LEN, b.y + SUCC(COLBAR_HEIGHT));
  56.  
  57.     SetColor(GREY);
  58.         Line(b.x + newlen, b.y, b.x + COLBAR_LEN, b.y);
  59.         ShowMouse;
  60. END;    (*  refresh_bar  *)
  61.  
  62. PROCEDURE    draw_color_bar(b : COORDS_TYPE);
  63. VAR    z : WORD;
  64. BEGIN
  65.         SetFillStyle(SOLIDFILL, BLACK);
  66.         Bar(b.x + 2, SUCC(b.y),
  67.         b.x + SUCC(COLBAR_LEN), b.y + SUCC(COLBAR_HEIGHT));
  68.  
  69.     FOR  z := 0  TO  PRED(COLBAR_HEIGHT) DIV 2  DO
  70.         BEGIN
  71.             SetColor(CLR_VISIBLE1 + z);
  72.                 Line(b.x, b.y + z, b.x + PRED(COLBAR_LEN), b.y + z);
  73.                 Line(b.x,              b.y + PRED(COLBAR_HEIGHT) - z,
  74.              b.x + PRED(COLBAR_LEN), b.y + PRED(COLBAR_HEIGHT) - z);
  75.     END;  (* FOR *)
  76. END;    (*  draw_color_bar  *)
  77.  
  78.  
  79. (*  draw_playfield draws the complete playfield, invoked only once per game  *)
  80. PROCEDURE       draw_playfield(scene : SCENE_TYPE);
  81. CONST    control_x = 8;
  82.     control_y = 423;
  83. VAR     col, row, row_n : COL_ROW_TYPE;
  84.     r_step         : SHORTINT;
  85.     myFrame        : FRAME_TYPE;
  86. BEGIN
  87.         dim_palette(0, SLOW_DIM);
  88.     HideMouse;    (*  heavy graphics ahead ...  *)
  89.  
  90.         generate_tile(scene, play_tile);
  91.  
  92.     SetFillStyle(SolidFill, GREY);    Bar(0, 0, GetMaxX, GetMaxY);
  93.  
  94.         (*  draw game-frame with black interior  *)
  95.       myFrame.init(PRED(scene.Origin.x), PRED(scene.Origin.y),
  96.             1 + SUCC(scene.Size.x) * scene.NumCols,
  97.             1 + SUCC(scene.Size.y) * scene.NumRows,
  98.             THICKWIDTH, BLACK, DKGREY, WHITE, GAD_NOT_PUSHED, TRUE);
  99.     myFrame.show;
  100.         (*  draw control-frame with grey interior  *)
  101.      myFrame.init(control_x, control_y, 624, 52,
  102.                NORMWIDTH, GREY, DKGREY, WHITE, GAD_NOT_PUSHED, TRUE);
  103.     myFrame.show;
  104.  
  105.         ShadowTextXY(control_x + 8, control_y + 12, WHITE, BLACK, 'TIME');
  106.     draw_color_bar(TIME_BAR);
  107.         ShadowTextXY(control_x + 8, control_y + 35, WHITE, BLACK, 'DONE');
  108.     draw_color_bar(DONE_BAR);
  109.  
  110.         IF  (GameStatus = PLAY)     THEN
  111.         BEGIN
  112.             GAME_PAUSE_GADGET.show;
  113.         GAME_QUIT_GADGET.show;
  114.         GAME_DEMO_GADGET.show;
  115.         END;  (* IF *)
  116.  
  117.         dim_palette(100, SLOW_DIM);
  118.  
  119.         (*  NumCols even  ->  0 ... (NumCols / 2) - 1
  120.             "   odd   ->  0 ... (NumCols-1 / 2)      *)
  121.         FOR  col:=0  TO  PRED(scene.NumCols) DIV 2  DO
  122.         BEGIN
  123.             (* ziczac graphics *)
  124.                 IF  ODD(col)  THEN
  125.                 BEGIN
  126.                        row_n := 0;  row := PRED(scene.NumRows);  r_step :=-1;
  127.                 END  (* IF *)
  128.                 ELSE  BEGIN
  129.                        row := 0;  row_n := PRED(scene.NumRows);  r_step := 1;
  130.                 END;  (* ELSE *)
  131.  
  132.                 WHILE  (row <> row_n + r_step)  DO
  133.                 BEGIN
  134.                         draw_tile(scene, play_tile, col, row, hidden0);
  135.                         draw_tile(scene, play_tile,
  136.                      PRED(scene.NumCols) - col,
  137.                      PRED(scene.NumRows) - row, hidden0);
  138.                         INC(row, r_step);
  139.                 END;  (* WHILE *)
  140.         END;  (* FOR col *)
  141.  
  142.         ShowMouse;
  143.  
  144. END;    (*  draw_field  *)
  145.  
  146.  
  147. (*  restore_playfield  hides visible and marked tiles  *)
  148. (*  necessary if you want to play the field AGAIN  *)
  149. {  it is in comments since we don't use it ...
  150. PROCEDURE       restore_playfield(scene : SCENE_TYPE);
  151.  
  152. VAR    col, row : COL_ROW_TYPE;
  153. BEGIN
  154.         FOR  row := 0  TO  PRED(scene.NumRows)  DO
  155.         BEGIN
  156.                 FOR  col := 0  TO  PRED(scene.NumCols)  DO
  157.                 BEGIN
  158.                         (*  hide visible and marked tiles  *)
  159.                         IF  (playfield[row,col] IN VISIBLE)  THEN
  160.                                 DEC(playfield[row,col], ORD(visible0) - ORD(hidden0))
  161.                         ELSE IF  (playfield[row,col] IN MARKED)  THEN
  162.                                 DEC(playfield[row,col], ORD(marked0) - ORD(hidden0));
  163.                 END;  (* FOR col *)
  164.         END;  (* FOR row *)
  165. END;    (*  restore_playfield  *)
  166. }
  167.  
  168. PROCEDURE       generate_playfield(scene : SCENE_TYPE);
  169.  
  170. VAR     col, colj, r_col,
  171.     row, rowi, r_row  : COL_ROW_TYPE;
  172.         mines_to_put      : BYTE;
  173.  
  174. BEGIN   (*  generate_playfield  *)
  175.  
  176.         (*  initialize playfield with hidden0's  *)
  177.         FOR  row := 0  TO  PRED(scene.NumRows)  DO
  178.                 FOR  col := 0  TO  PRED(scene.NumCols)  DO
  179.                     playfield[row, col] := hidden0;
  180.  
  181.         mines_to_put := scene.NumMines;
  182.         REPEAT
  183.                 col := Random(scene.NumCols);
  184.                 row := Random(scene.NumRows);
  185.                 IF  (playfield[row, col] <> hidden_mine)  THEN
  186.                 BEGIN
  187.                     DEC(mines_to_put);
  188.                     playfield[row, col] := hidden_mine;
  189.             (*  increase counters around the mine  *)
  190.                         (*  note that the playfield is a circular one, i.e.
  191.                 left and right, upper and lower edges butt together *)
  192.                 FOR rowi := PRED(row) TO  SUCC(row)  DO
  193.                         BEGIN
  194.                             r_row := real_row(scene, rowi);
  195.                 FOR colj := PRED(col)  TO  SUCC(col)  DO
  196.                                 BEGIN
  197.                                     r_col := real_col(scene, colj);
  198.                     (* don't increase hidden_mines *)
  199.                             IF  (playfield[r_row, r_col] IN [hidden0..hidden7])  THEN
  200.                         INC(playfield[r_row, r_col]);
  201.                                 END;  (* FOR colj *)
  202.                         END;  (* FOR rowi *)
  203.                 END;  (* IF *)
  204.         UNTIL  (mines_to_put = 0);
  205. END;    (*  generate_playfield  *)
  206.  
  207.  
  208. (*  explode with its subroutines handles the complete 'BLASTED' event  *)
  209. PROCEDURE    explode(VAR  scene : SCENE_TYPE;
  210.               col, row : COL_ROW_TYPE);
  211. VAR    mines : ARRAY[1..MAX_MINES] OF
  212.             RECORD
  213.                             col, row : COL_ROW_TYPE; (* the 'home' tile *)
  214.                                 x, y     : WORD;     (* center of this tile *)
  215.                 age     : BYTE;     (* the phase *)
  216.                         END;
  217.  
  218.     first_mine, last_mine,
  219.         width, height          : WORD;    (*  size of the scene, both -1 *)
  220.  
  221. PROCEDURE    add_mine(VAR    scene : SCENE_TYPE;
  222.                  col, row : COL_ROW_TYPE);
  223. VAR    x, y : WORD;
  224. BEGIN
  225.     INC(last_mine);
  226.         mines[last_mine].col := col;
  227.         mines[last_mine].row := row;
  228.         get_tile_middle(scene, col, row, x, y);
  229.     mines[last_mine].x := x - scene.Origin.x;
  230.     mines[last_mine].y := y - scene.Origin.y;
  231.  
  232.         mines[last_mine].age := 0;
  233. END;    (*  add_mine  *)
  234.  
  235. PROCEDURE    draw_block(x1, y1, x2, y2 : INTEGER;  color : BYTE);
  236. VAR    bl : ARRAY[1..4]  OF        (* a block may split up into 4 blocks *)
  237.         RECORD
  238.                     x1, y1, x2, y2 : INTEGER;
  239.                 END;
  240.     i, num_bl, start : BYTE;
  241. BEGIN
  242.     (*  first: normalize coordinates, so that (x2,y2) in playfield  *)
  243.         IF  (x2 >= width)  THEN
  244.         BEGIN
  245.             DEC(x2, width);  DEC(x1, width);
  246.         END;
  247.         IF  (y2 >= height)  THEN
  248.         BEGIN
  249.             DEC(y2, height);  DEC(y1, height);
  250.         END;
  251.  
  252.         bl[1].x1 := x1;  bl[1].y1 := y1;  bl[1].x2 := x2;  bl[1].y2 := y2;
  253.     bl[2] := bl[1];
  254.  
  255.         IF  (x1 < 0)  THEN
  256.         BEGIN
  257.                 (*  draw 2 blocks, one on the left, one on the right edge *)
  258.             start := 1;  num_bl := 2;
  259.                 bl[1].x1 := 0;
  260.                 bl[2].x1 := width + x1;
  261.                 bl[2].x2 := PRED(width);
  262.     END
  263.         ELSE BEGIN
  264.                 start := 3;  num_bl := 1;
  265.             bl[3] := bl[1];
  266.         END;
  267.         IF  (y1 < 0)  THEN
  268.         BEGIN
  269.                 (*  draw 2*num_bl blocks, num_bl on the upper, num_bl on the lower edge *)
  270.                 FOR  i := 1  TO  2  DO
  271.         BEGIN
  272.                         (*  copy the blocks 1, 2 onto 3, 4  *)
  273.             bl[2 + i] := bl[i];
  274.             bl[1 + i].y1 := 0;
  275.                     bl[i * i].y1 := height + y1;
  276.                     bl[i * i].y2 := PRED(height);
  277.                 END;  (* FOR *)
  278.         INC(num_bl, num_bl);
  279.     END;  (* IF *)
  280.  
  281.         SetFillStyle(SOLIDFILL, color);
  282.         FOR  i := start  TO  start + PRED(num_bl)  DO
  283.             Bar(bl[i].x1, bl[i].y1,  bl[i].x2,  bl[i].y2);
  284.  
  285. END;    (*  draw_block  *)
  286.  
  287. PROCEDURE    gather_hidden_mines(VAR    scene         : SCENE_TYPE;
  288.                              col, row, delta : COL_ROW_TYPE);
  289. VAR    colj, rowi,
  290.     r_col, r_row : COL_ROW_TYPE;
  291.         cont_val     : WORD;
  292.         contents     : CONTENTS_TYPE;
  293. BEGIN
  294.     FOR  rowi := row - delta  TO  row + delta  DO
  295.         BEGIN
  296.             r_row := real_row(scene, rowi);
  297.         FOR  colj := col - delta  TO  col + delta  DO
  298.             BEGIN
  299.                 r_col := real_col(scene, colj);
  300.  
  301.                         contents := playfield[r_row, r_col];
  302.                         IF  (contents IN [visible1..visible8])  THEN
  303.                         BEGIN   (*  decrease the score  *)
  304.                             cont_val := ORD(contents) - ORD(visible0);
  305.                 IF  (Score > cont_val)  THEN
  306.                     DEC(Score, cont_val)
  307.                 ELSE
  308.                     Score := 0;
  309.                             (*  hide this tile, so that
  310.                     the score won't be decreased again as
  311.                     the explosion continues  #22.11.92 *)
  312.                             DEC(playfield[r_row, r_col], ORD(visible0)-ORD(hidden0));
  313.                         END  (* IF *)
  314.                         ELSE IF  (contents = hidden_mine)  THEN
  315.                         BEGIN
  316.                             (*  show mine so that it won't explode again  *)
  317.                             playfield[r_row, r_col] := visible_mine;
  318.                             (*  only HIDDEN mines will explode, marked mines won't  *)
  319.                                 add_mine(scene, r_col, r_row);
  320.                         END;  (* IF *)
  321.                 END;  (* FOR *)
  322.         END;  (* FOR *)
  323. END;      (*  gather_hidden_mines  *)
  324.  
  325. (* constants and variables local only in explosion *)
  326.  
  327. CONST    oldest_age = 7;
  328. VAR    x1, y1, x2, y2,
  329.     dist_down, dist_right,
  330.     dist_up, dist_left    : INTEGER;
  331.         dist_x, dist_y         : ARRAY[0..oldest_age] OF INTEGER;
  332.     color               : BYTE;
  333.         mine, t,
  334.     xp, yp, xm, ym        : WORD;
  335.  
  336. BEGIN    (*  explode  *)
  337.         HideMouse;
  338.  
  339.         (*  calculate the size of the explosions  *)
  340.         get_tile_pos(scene, 0, 0, xp, yp);
  341.         get_tile_middle(scene, 0, 0, xm, ym);
  342.         dist_left := xm - xp;
  343.         dist_right := scene.Size.x - dist_left;
  344.         dist_up := ym - yp;
  345.         dist_down := scene.Size.y - dist_up;
  346.  
  347.     FOR  t := 0  TO  oldest_age  DO
  348.         BEGIN
  349.             dist_x[t] := SUCC(scene.Size.x) * (t SHR 1);
  350.                 dist_y[t] := SUCC(scene.Size.y) * (t SHR 1);
  351.         END;  (* FOR *)
  352.  
  353.         width := PRED(SUCC(scene.Size.x) * scene.NumCols);
  354.         height:= PRED(SUCC(scene.Size.y) * scene.NumRows);
  355.         SetViewPort(scene.Origin.x, scene.Origin.y,
  356.             scene.Origin.x + width, scene.Origin.y + height, ClipOFF);
  357.  
  358.     first_mine := 1;    (*  no mines removed yet  *)
  359.         last_mine := 0;     (*  no mines added yet  *)
  360.     add_mine(scene, col, row);
  361.  
  362.     REPEAT
  363.                 (* use a WHILE-loop instead of FOR, since last_mine is being
  364.            altered during the loop  *)
  365.             mine := first_mine;
  366.             WHILE  (mine <= last_mine)  DO
  367.                 BEGIN
  368.             WITH  mines[mine]  DO  (*  col, row, x, y, age  *)
  369.             BEGIN
  370.                                 IF  (SoundIsON)  THEN
  371.                     Sound(age * 8 + 20);
  372.  
  373.                             x1 := x - (dist_x[age] + (age AND 1) * dist_left);
  374.                             y1 := y - (dist_y[age] + (age AND 1) * dist_up);
  375.                             x2 := x + (dist_x[age] + (age AND 1) * dist_right);
  376.                             y2 := y + (dist_y[age] + (age AND 1) * dist_down);
  377.  
  378.                                 (*  colors are  clr_visible2..clr_visible7, DKGREY and BLACK  *)
  379.                 color := SUCC(CLR_VISIBLE1) + age;
  380.                         CASE  age  OF
  381.                                 2         :  gather_hidden_mines(scene, col, row, 1);
  382.                                     4         :  gather_hidden_mines(scene, col, row, 2);
  383.                                     oldest_age-1,
  384.                                     oldest_age  :  color := oldest_age - age;
  385.                 END;  (* CASE *)
  386.  
  387.                             draw_block(x1, y1, x2, y2, color);
  388.         
  389.  
  390.                             INC(age);
  391.                                 (*  remove oldie mines  *)
  392.                                 IF  (age > oldest_age)  THEN
  393.                                     first_mine := SUCC(mine);
  394.             END;  (* WITH *)
  395.                         INC(mine);
  396.                 END;  (* WHILE *)
  397.  
  398.         UNTIL    (first_mine > last_mine)  OR  ESC_pressed;
  399.  
  400.         (*  if player pressed ESC then don't show the score ... QUIT *)
  401.         IF  (first_mine <= last_mine)  THEN
  402.         GameStatus := QUIT;
  403.  
  404.         IF  (SoundIsON)  THEN
  405.         NoSound;
  406.  
  407.     SetViewPort(0, 0, GetMaxX, GetMaxY, ClipOFF);
  408.         ShowMouse;
  409. END;    (*  explode  *)
  410.  
  411.